perm filename MFBASE.SAI[MF,DEK] blob
sn#560387 filedate 1981-01-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 A list of the type codes
C00016 00003 The hash table: hashh, hname, idlookup, idremove, idhide
C00023 00004 wxy-variables and area headers: wxylookup, indexname, idname
C00032 00005 The input stacks: inbuf,curbuf,state,loc,recovery,filename
C00037 00006 Tokens, token lists, and the diagnostic routines dumplist,dumptokens
C00044 ENDMK
C⊗;
comment A list of the type codes;
comment The following definitions attach numeric codes to the various
"types" output by getnext for interpretation by the METAFONT routines.
The symbolic names of these codes are used everywhere in the program,
so you don't need to read this page except when debugging. An attempt
has been made to choose code numbers so that the range of types in
case statements is reasonably small;
internaldef innput=0 # "input";
internaldef rel=1 # "<", ">", "=", "≠", "≤", or "≥";
internaldef ddot=2 # "..";
internaldef rpren=3 # ")";
internaldef lbrace=4 # "{";
internaldef rbrace=5 # "}";
internaldef hashmark=6 # "#";
internaldef comma=7 # ",";
internaldef colon=8 # ":";
internaldef varparam=9 # "var";
internaldef indexparam=10 # "index";
internaldef semi=11 # semicolon;
internaldef quote=12 # """";
internaldef stop=13 # "end";
internaldef fullstop=14 # period ending a routine or subroutine;
internaldef iff=15 # "if";
internaldef elsse=16 # "else";
internaldef ffi=17 # "fi";
internaldef ident=18 # identifier;
internaldef wxy=19 # "w", "x", or "y";
internaldef rbrack=20 # "]";
internaldef lbrack=21 # "[";
internaldef digit=22 # "0", "1", ..., "9";
internaldef pnt=23 # ".";
internaldef apost=24 # "'";
internaldef letter=25 # "A", "B", ..., "Z", "a", "b", ..., "z";
internaldef equals=26 # "=";
internaldef openq=27 # "`";
internaldef space=28 # " " or character ignored by scanner;
internaldef carret=29 # carriage return or form feed or "%";
internaldef abbs=30 # "|";
internaldef index=31 # index argument;
internaldef lpren=32 # "(";
internaldef char=33 # single character in constant or subroutine call;
internaldef constant=34 # (real) constant;
internaldef plusorminus=35 # "+" or "-";
internaldef timesordiv=36 # "." or "*" or "⊗" or "/";
internaldef randm=37 # "nrand";
internaldef known=38 # variable whose value is known;
internaldef direction=39 # "lft" or "rt" or "top" or "bot";
internaldef dependent=40 # variable whose value is a dependency list;
internaldef newid=41 # identifier whose type has not yet been assigned;
internaldef independent=42 # variable whose value is independent;
internaldef unary=43 # "sqrt" or "round" or "good";
internaldef subroutine=44 # identifier corresponding to a stored subroutine;
internaldef penname=45 # "cpen" or "hpen" or ... or "spen" or "epen";
internaldef cawl=46 # "call";
internaldef new=47 # "new";
internaldef mfparam=48 # "charcode", "maxvr", etc.;
internaldef contrl=49 # "proofmode", "pause", "eqtrace", etc.;
internaldef no=50 # "no";
internaldef draw=51 # "draw";
internaldef ddraw=52 # "ddraw";
internaldef subrtn=53 # "subroutine";
internaldef param=54 # identifier that is a parameter;
internaldef varchar=55 # "varchar";
internaldef charlist=56 # "charlist";
internaldef texinfo=57 # "texinfo";
internaldef lig=58 # "lig";
internaldef invisible=59 # "invisible";
internaldef break=60 # "crsbreak";
internaldef kern=61 # "kern";
internaldef binput=62 # "binput";
internaldef areahead=(2↑types-1) # area header node;
comment The following codes are used for second-order differences;
internaldef lft=0 # "lft";
internaldef rt=1 # "rt";
internaldef top=2 # "top";
internaldef bot=3 # "bot";
internaldef root=0 # "sqrt";
internaldef sine=1 # "sind";
internaldef cosine=2 # "cosd";
internaldef round=3 # "round";
internaldef good=4 # "good";
internaldef cpen=0 # "cpen";
internaldef hpen=1 # "hpen";
internaldef vpen=2 # "vpen";
internaldef lpen=3 # "lpen";
internaldef rpen=4 # "rpen";
internaldef spen=5 # "spen";
internaldef epen=6 # "epen";
internaldef badpen=7 # illegal pen type (the initial value);
comment The following table assigns type codes to all ascii characters;
preload_with space,space,space,space,space,space,space,space,
space,space,space,space,carret,carret,space,space,
space,space,space,space,space,space,timesordiv,space,
letter,space,carret,rel,rel,rel,letter,space,
space,space,quote,hashmark,space,carret,space,apost,
lpren,rpren,timesordiv,plusorminus,comma,plusorminus,pnt,timesordiv,
digit,digit,digit,digit,digit,digit,digit,digit,
digit,digit,colon,semi,rel,equals,rel,space,
space,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,wxy,
wxy,wxy,letter,lbrack,space,rbrack,space,space,
openq,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,wxy,
wxy,wxy,letter,lbrace,abbs,rbrace,rbrace,space;
saf integer array chartype[0:127] # type codes for METAFONT scanning;
comment The following data is used for METAFONT's basic parameters;
internaldef realpars=23,intpars=10, stringpars=2 # number of real, integer, and string parameters;
internaldef penparam=realpars+4 # distinguish the first four integer parameters;
internaldef intpar=realpars # offset used for integer parameters;
internaldef stringpar=realpars+intpars # offset used for string parameters;
internal saf real array realparam[1:realpars] # real parameters to METAFONT;
internal saf integer array intparam[intpar+1:intpar+intpars] # integer parameters;
internal saf string array stringparam[stringpar+1:stringpar+stringpars] # integer parameters;
internaldef xxtr=⊂realparam[1]⊃, xytr=⊂realparam[2]⊃, xtr=⊂realparam[3]⊃,
yxtr=⊂realparam[4]⊃, yytr=⊂realparam[5]⊃, ytr=⊂realparam[6]⊃;
internaldef charwd=⊂realparam[7]⊃ # width of character to be output;
internaldef charht=⊂realparam[8]⊃ # height of character to be output;
internaldef chardp=⊂realparam[9]⊃ # depth of character to be output;
internaldef charic=⊂realparam[10]⊃ # italic correction of character to be output;
internaldef safetyfactor=⊂realparam[11]⊃ # extra factor for overlap in ddraw;
internaldef maxvr=⊂realparam[12]⊃, minvr=⊂realparam[13]⊃,
maxvs=⊂realparam[14]⊃, minvs=⊂realparam[15]⊃ # velocity thresholds;
internaldef epenxfactor=⊂realparam[16]⊃, epenyfactor=⊂realparam[17]⊃,
excorr=⊂realparam[18]⊃, eycorr=⊂realparam[19]⊃ # parameters for \&{epen}s;
internaldef designsize=⊂realparam[20]⊃ # nominal height of font to be output,
expressed in points;
internaldef xresolution=⊂realparam[21]⊃, yresolution=⊂realparam[22]⊃ # of
output, expressed in pixels per point;
internaldef magnification=⊂realparam[23]⊃ # factor by which logical font has
been expanded or contracted, a pure number;
internaldef hpenht=⊂intparam[intpar+1]⊃ # hpen height;
internaldef vpenwd=⊂intparam[intpar+2]⊃ # vpen width;
internaldef lpenht=⊂intparam[intpar+3]⊃ # lpen height;
internaldef rpenht=⊂intparam[intpar+4]⊃ # rpen height;
preload_with "hpen height","vpen width","lpen height","rpen height";
saf string array sympar[intpar+1:intpar+4];
internaldef dumplength=⊂intparam[intpar+5]⊃ # length of strings for dumping;
internaldef charcode=⊂intparam[intpar+6]⊃ # ascii code of character to be output;
internaldef chardw=⊂intparam[intpar+7]⊃ # device width of character to be output;
internaldef seed=⊂intparam[intpar+8]⊃ # controls random number generator;
internaldef dumpwindow=⊂intparam[intpar+9]⊃ # number of characters in error m'ges;
internaldef maxht=⊂intparam[intpar+10]⊃ # maximum height above baseline;
internaldef fontidentifier=⊂stringparam[stringpar+1]⊃ # a string that names
all sizes, logical and physical, of the current font. This
string incorporates the PARC notions of family and face: for
example, "CMR", "CMSS", "CMTT", ...;
internal integer control # bits that control various METAFONT functions;
comment The individual control bits have the following significance:
'1 tracing definitions of variables
'2 tracing titles of routines
'4 tracing calls of subroutines
'10 pausing before each input line from a file
'20 warning messages if page ended unexpectedly
'40 pen type and size are undefined on entry to subroutine
Bits '100 thru '400 are defined in MFRAST (if anywhere)
Bits '1000 thru '400000 are defined in MFOUT for particular output modes
Bits '1000000 thru '4000000 govern on-line raster display;
define trdefs=⊂(control land 1)⊃, trtitles=⊂(control land 2)⊃,
trcalls=⊂(control land 4)⊃, pausing=⊂(control land '10)⊃,
warning=⊂(control land '20)⊃, penreset=⊂(control land '40)⊃;
comment The hash table: hashh, hname, idlookup, idremove, idhide;
comment Identifiers, some of which are predeclared as "reserved words,"
are recorded in a hash table, with an associated table of their equivalent meanings.
This table is accessed via "chaining with separate lists" (cf. Section 6.4 of
ACP)--in other words, there are three parts to the table: An array hashh contains
list heads for each possible hash code--these list heads are pointers into mem,
starting a linked list representing all identifiers having a given hash code.
Identifiers that represent parameters in more than one subroutine appear several
times in the linked list, once for each subroutine.
Another array hname contains the first few characters of each identifier.
(As many 5-bit characters are kept as will fit in a machine word.)
The third part of the hash table consists of the linked lists in mem, with two-word
nodes containing type, name, and link fields in one word and a value field in the
other. The type and value fields are reported by getnext after it finds the
identifier. The name field points to the hname array, and the link field points
to the next node in the list.
The hash code for an identifier is the remainder of (first few characters)+(length)
divided by the size of the hashh table. Thus, identifiers with the same first few
characters but different lengths (modulo the size of hashh) will never be confused
with each other;
internaldef hashsize = 89 # hash8&3∃π≠'k∃bβO#?.c⊃β*βCK'n)l4+NsS↔Kv3∪↔2β;π7/≠'k∃βi↓MAα↓
β7∂C'7Wjβ;W7⊗+Iβ?2β∪'≠6+K↔;"β'∪↔w#'≠'/∪M1βO→↓qqβ∩{;πn+Ml4V≠?77.sQαSF)β∪'63↔K↔v≠∃β/#←↔↔r↓J{;∞k↔Mβ∞s⊃β;∞k↔O'V)β'Mπ##∃βnc'7.iβπ3f{←πf(4('∨+O∂⊗KCQβ}qβ¬β:i1βajaβ?IπI7[π⊗Kπ3+X4+'w#↔K;∞aβOπ2β';S.;↔Iβ∂∪KπeεCπO#EYAk#∂≠#O'V)5Fuα→β3'∨!β#↔∞#Mβ≠␈⊃β#π≡C';≥Xh+';&+K;πbβOπ→εK;S↔>+Iβπ↔∪πeβFsπ7⊗[↓k;πn+O'k*iFu↓~β≠'K∨!β∂#∂∪π∂S/∪Mβ?2β'∪↔w#'≠'/∪Ml4VK;S↔⊗sπ1βNsS↔∨/⊃β#C'⊃↓
βw+7↔∩β?→β&K≠≠↔⊗+;QβN#↔;SN3'↔K~β∂WK⊗+;S3Jβ'9βn+7?KKX4(4VK;S↔⊗sπ3∪.1βSgε+MuYbβSgC.!w''≠C↔K>!7Sgε+L%
π#gC∃ε3'↔3"β'9βv{∪↔MXh+';&+K;πf#↔→βv7↔Mo#gC↔"k3';←→1β;∞k↔⊃wfK;/MI
β;∞k∃β≠N+3⊃βNqβ;?&+Ml4VK;S↔⊗sπ3∪.1βSgε)#A%iβ≠'↔f!#Sgε)37↔m[Bu$λI
βSOβ∃β≠N+3⊃βNqβ;?&)βAlhS';S/∪;π3&+→β;∞k∃#AKhC≠'.c⊃#;∞k∃37.joBuIλ%
βv7∃β6K↔3⊃εK9β;}#∃βAXh+';&+K;πf#↔→β⊗KSOK.iw''≠C↔K>!β7?"↓U↓
ε+cSK
β'S~βπQβf+≠Qβ}1β#;∞k∃β↔w#K'↔≠X4+∪.3';∃εc↔SOε+K←⊃jC'S∨β↔K←"k'S∨∪↔5'&KY↓Uα→β;Wn∪↔Iβ}1β3↔'#↔KMπβ↔Iβ>{K⊃lhP4+'w#↔K;∞aβ?}c↔π9ε3?K∂.#;↔]α→β'∪.sS'≠N+Iβ←F+9β3}{/↔⊃π+Aβ←Nc1β;␈!β7π&≠!βπwIβ?SF+Il4Ph+';&+K;πbβ';S.;↔Iβπ∪?∂↔'+K∃βN#3??←+A#'w#↔∨↔∩β≠'K∨#≠↔]fc↔;∨&A%↓
εc??-ε3?IβN#↔;SN3'↔IXh+↔>K9β∂}k7↔;"αS#'~βCK?≡+∪WK*β≠';'→βS#*β∨'[.qβ'∪.sS'≠N+IβW≡K;≥β&C∃β#∂≠!βS∞∪3∀4Vk↔∂#∞s'O7~aβ';≡+KS'v9β'QαC←'SBβSgC*β∂?∪*↓;↔>K⊃ β∞s⊃β[∞cW∃βε{';SNs≥βSxh+'S≡+3→%εK→β'"β'Mβv{QβC⊗+O↔;"βπ3K.∪e9∧K→β∨f{π1π3πK'∞∪3∃↓⊗3?K∂.#;↔]∩β'Mβ'∪W∃1π##∀4V;'[↔rβ'∪↔w#'≠'/⊃β'Mε∪∪↔"βS=β&C∃βS∞∪3∃β/3↔9βN1β'QεKMβπg∪↔π∪JβCK↔≡+;QlhS';S.;↔IβBcEl4VB⎇#≠O∪OS≠/9/3↔v;S!'n{⊃β#∂≠#O'V)mβF}CπO#E["ulhS'→βv{Qβ≠␈∪∂↔∪v+]βSF+9β←FK3∃β
β∪<4PK↔∨Nqβ'→εC;π7-[;π7*CE&un3'KO&3↔]β&C↔9β⊗+SWKrCE%lhP'F␈fK;-#
Il4(N+;⊃lhS∂?7n+;QαN#↔;SN3'↔Iεs?Qβ6{W;⊃bβ7WO"β';O/∪Qβ'#X4+'2β#CS⊃k;π7/≠'k∃π##↔9ε{[↔K6c?]#v7↔OOS∃%lhS#;πn*o#C'∩v␈≠O∪OS≠/9↓
βv+]β;∞k∃β'w#=βSF)βSπ⊗c∃l4V;↔S[∂3π'1G %mβn+6oFmy#;↔>K⊃β3≡AβSgε+⊃%-FCCSIεcO!βv7↔⊃J[#πOFBo"uXh+[7.k';QG &␈EZβ#πOFBo"v␈ l4+GβSJ␈GβSI-X4+K/#WK9G %l4V+;⊃lhP4+C⊗{∂↔∪/∪∃β'&C'∪∃FK;S↔>+Iβ'f{
%↓~β∂?[/∪MβWαβπ9βN#↔;SN3'↔IXh+↔>K9β∂}k7↔;"αS#'~βCK?≡+∪WK*β7π//→βπ9εK∪↔;&K≠'↔∩β';[O≠'3*aβ∨'6+9βSF)β3?≡S'?ph+?→π##πQεK∪↔;&K≠'↔∩;Mβ↔w#KeβNqβS#*β7↔5εKKπJq↓"'"β'Mβ/≠↔⊃β6{IβO.∪K?W&K;∀4VK∨Wn+;SMε≠S↔∩βS#∃π≠WK␈+S';*β#πMε∪↔↔9π≠S?K.!βπ←∂I9%lhS';S.;↔Iβ"↓
βS.kC?K∂∪eβO&{Kπ∨*β≠?Iεc↔SS/∪Mβ←FK3∃β≡{7CW&K;≥β&C∃β3.s∨S!Xh+';&+∨↔Iεa↓
βf+;∨SCX4+'w#↔∨↔∩β!↓
εCπO!εc?∂π&K?9lhS';S.;↔Iβα↓
βC}K;S↔∩βS#π"β≠?3f{←MβX4+'w#↔∨↔∩βE↓
πβ?';&+IβSFQβK.sMβSG∪?W∨Bβ#πOBβ3'O'→l4+⊗{?3↔∞qβ?;≡+S#K*↓
β←*β#π[*βKW9π#=βSF)β↔;"β?→β&C∃β#∂≠!βS∞∪3∃lhS'→βv7∃#Nc?
%↓iβ#C'⊃βS#.qβ∂?v3WO'}q↓
β&C∃β'&+;S'6K↔IβO→βπO∨+7↔⊃πβK↔O.sQl4VB␈R␈Fsπ7⊗↑sπ7∃FK3?
Mil4+N1βQβf;⊃↓;→]βSF+9β2}c↔SOε+K←⊂hS↔3O(K↔∨Nqβ2⎇YβR␈"βK?QF∪'SO⊗+5-EαIl4(O;#'3*βQβ3∞s⊃↓≥≠9β∪<hP$'.;'9βe{1-EZβR␈Qπ∪?Q↓+X4($N+;⊃lhP'↔;#X4+"zC!/1Nk?⊃βFO#OOS∃mβ}s∂↔SG∪V␈≠∞cO∃lhS3??K↔∨NqβB⎇βYβF␈FO#"↑Bul4PK←#'f)βEβ&yβ'→π w'3}→βS#.p4($N∪↔∨'rβ'→ββiAβSF+9β#∂≠#"oEj␈3'vY#E%ε+3O∃π≠↔S3Ns-#Afc';-G %%lhP$'K/#WK9Xh($'.s⊂4(N+3O∀N∪↔∨'rβB␈EZβF␈3Ns-#EKX4($N+;⊃lhP'"␈BYEmβN1β wFO#OOS∃βSF+84(HK↔∨Nqβ'→ε{;∂↔&CKUβ&C↔9β≡{;≠W≡K?9lhP$'"{↓mβ?v≠↔S#↔*␈SK.)l4(HK↔;⊃Xh('↔v!l4+.s⊃l4P3∂?nk↔;Qπ;ce76K'π⊗c↔Mβ∞s⊃βπ⊗+¬β#.∪↔K≠Qβ←cNc??//↓1β'v#↔c;∞k∃1βN#;π7+X4(4V≠?77.sQαSF)α6⊗$
~>:"β3π;?+π∨∃ε;'[↔~βOC↔≡Kπ1βn+π;'v9βS=εK∪↔;&K≠'↔↔→βS#∂!β↔>K84+>KS!β:aβa1ε{Iβebβ;π7.ceβSF+eβ7/≠Qβ*β?→β&C∃β≠␈∪5β]fK;∪↔Cqβ?IπAs';&+ayβ␈⊂4+efK;∪↔Cq9α'w≠'∪∃π##∃αl*Rε~|rQβOO≠S↔5ε9β'v#↔aβ6K'π⊗c∃β'~βK↔C⊗+O↔;&+⊃βπ~β¬βC∞KH4)FK;≠=fc';-Jβ←#↔⊗)β';6yβ'Mε βO7∞c1β'w#↔∨↔∩βOW≡≠K'C"βπ;⊃εc';-πβ?';'→βS=ε84)⊗K↔¬εC↔π∪/⊃ 9α>KS#'rβ¬βO.∪K?W&K;∃1πAEβK.3↔KMπ#=β¬π3πK'∞∪3∃βf{∂π1π#=βSFP4+∨+K?/#';∃bβπ;⊃ε31βBk[πKN3↔~β?→β&CπQβ∨+K?/#';∃εK∃β∞#∪K↔∨≠↔⊃β6K¬β''→βπK.λ4+#.∪↔IrαS#∃εK↔¬εC↔π∪/⊃β?→π##∃βn'9βπ∪?∨K∞i↓#%v)91β␈+SO'&)βOW↔∪?WSNs↔M%εKMβC}K;S↔ h+S=ε∪e↓n'9 ph(4*fK;/↔"β3'O'→βπK*β7π'w#π';.!β≠?∩βS#∃πA7[π⊗Kπ3/→βπ;"βe7[∂∪'πf+Mβ?2β↔π∂BβπK↔
p4)"∞c1β]o3πK'∞∪3↔Mε≠?7∃ε3K?5ε βO'v;3∃β∂∪↔¬1π;#?O*β3'O"βOSπ↔#Mβ'rβ7↔6←;[πJjq$4*&C∃β;∞k∃β≠N+3⊃βNqβS#O→β3'∨!β'Mπ##∃β∨+O∂⊗KCQβεcWMβv7↔OOS∃1β>C'3∃π##∃β'KC∃β∞s⊂4+63W∃ε3'↔3'→βπK*βS#∃π≠π7∃εMβ≠␈⊃β?K&K;πKJβ'∪↔w#'≠'/∪M9α&C∃β3O≠SMβ∂∪∃β//βQβ'ph+?K&+IβJβOW≡≠K'C"aβπ;"βS#∃εcπOQεs?∪∃ε{→βSF)β3'∨!βC?NsSMβ⊗∂-β&yβS#*βπK↔λh+#↔∞#↔I8hP4*πrβπK↔
β#↔π&+IβAεKMβ¬π#←=7>{K⊃βv{∪∃β≡{;SπNs';≤hP'πK.#↔π"aβ'9π##∃β'KC∃β6K↔3⊃ε{→β7.joBthP'¬β≡CπKπ∨#↔Iβ≡{∪∃1εK9βSF)β;πn)β≠'.c⊃β?2β7↔6←αu↓#*s≥91α∪∂π3fβ
β}qβ∧4PH'OW↔∪?WSNs∃βC/#M↓~⊃β'9π##'Mε3'↔3"H4('ε{';S/⊃βS=ε+;∂3␈≠';≥εK↔¬εC↔π∪/⊃1β'rβS#∃εc';-ε3'↔3"β?→βn+6oBhh('C}K;S↔∩βS=β6KKOQπA7[π⊗Kπ3*aβ'9π##∃βNs≠=β6K↔3⊃ε{→β[n+7';"CA$4PKC?'w#↔Iβ&yβ≠'↔≠Qβeo3πK'∞∪3∃1εK9βSF)β3'vYβ≠'.c⊃β?2β[7↔nK;Q#αI84*&C∃βπ⊗+¬β#.∪↔K~β'9β/C'OS.s∂∃β∂!βπ;Jβ∨'[.qβS'n)β∂?w≠S'S/#∃β¬π≠Sπ∂Zβ∂?K⊗+OC?v#';≤hSS=β∨+K?/#';↔~βS#π"β#π[*β↔↔rβ∂π3f+⊃βπv!β;?"βg↔Qπ#↔K7NsπS↔"qαS#*β∨3?⊗1β[∂∪'πf(4+∂/∪πK↔
βC?'w#MβSzβS#∃π#?Aβ}1βS#O→βOS∞≠-1β>C'3∃εkπ'9πβ?';'→βS=π##∃β⊗{SS?kX4(4VK;S↔>+Iβ∂/∪πK↔
↓
βC}K;S↔∩βS=β&C∃β∂/∪K↔;"βπK↔
β#↔π&+Il4Ph+∂?nk↔;Q¬##∃β6{33?>K;≥βπ∪?∂↔'+K↔MεK∃β/≠↔⊃β&yβπ∂≡+OMβ?Ce7[∂∪'πf+M1β∞sπ3?>{WMβ&x4+SF)βK?/#';↔~β≠?Iε{S#↔∩β'∪↔w#'≠'/∪Ml4Ph+';&+∨↔IπβK?∂.#WK∃π;cg3}{/WAFK;S↔>+Iβ∂G⊃3';'A%↓
ε3';⊃ε β←cJk'∪↔w#'≠'/⊃l4+⊗+∨'9ε≠?77.sQαSFKMβC⊗{∂↔∪/∪∃β≠Ns∪Mβ
β∨'[.qβ←cJk[πKN3∃bβ←#↔rβ∂#IεKL4)↔9 1↓↔A 1β␈⊃↓e∩aβ7?"↓MI1ε;⊃βNs∪aβO→βπ9εK;∪↔Bβ[π3.)l4+NsS↔∨/⊃β93αcE35gβK↔[βX4+:}3'↔3"C';≠zc';∪BI/;πn+O'k+X4+∂∂≠∃β∂G⊃β?→ε∪↔∨'ph*m:⊃β3πv!↓≥M=iβB␈fK;-#?3πI%Xh*mB⊃β3πv!↓≥M=iβ↔>K9β6}3'↔3"C3';Zc';∪BImβBield(info,vmemint(m)) end;
["y" land '37] begin m←field(link,indx); p←field(link,vmemint(m)) end;
else confusion
end;
prevp←0 # indicates that p was found in the area header node;
while type(p)≠areahead do
begin integer nn;
if(nn←name(p))>n then done
else if nn=n then return(p);
prevp←p; p←link(p);
end;
comment The variable is not in the list, it needs to be inserted
between prevp and p;
if n≥(1 lsh names) then overflow(names) # not enough bits to represent such a
large subscript;
getvavail(q);
mem[q]←(newid lsh typed)+(n lsh named)+p; vmemint(q)←q;
if prevp then setlink(prevp,q)
else case chr of begin
["w" land '37] setlink(wvar,q);
["x" land '37] setfield(info,vmemint(m),q);
["y" land '37] setfield(link,vmemint(m),q);
else confusion
end;
return(q);
end;
internal string procedure indexname(integer i) # symbolic name of an index value;
begin comment If the main procedure says call"a" sub1 and sub1 says call"b" sub2
and the argument i is an index for variables x3 and y3 in sub2, this
procedure returns the string "ab3";
string s; integer p; s←"";
p←field(link,i);
while p≠main do
begin if name(p) then s←name(p)&s;
p←link(p);
end;
return(s&cvs(field(info,i)));
end;
integer idarea # communication between entersym and idname;
internal string procedure idname(integer p) # produces name for printouts;
begin comment This procedure is sort of an inverse to idlookup and wxylookup:
Given the output of one of those procedures, it figures out the corresponding
identifier. Since the procedure is used only for error messages, it need not be
too efficient. If the identifier begins with "x" or "y", global variable
idarea is set to the corresponding areahead;
integer n; string s;
if(n←name(p))<namesize then
begin comment normal identifier;
integer t,x,l,i;
t←hname[n] lsh bitsrem; s←""; l←0;
while(x←(t rot 5)land '37) do
begin s←s&(x+'140); l←l+1; t←t lsh 5;
end;
if l<letsperwd then return(s);
for i←1 thru 10 do
begin comment try to find the identifier;
integer q;
q←hashh[(hname[n]+l)mod hashsize];
while q do if q=p then return(s) else q←link(q);
s←s&"x"; l←l+1;
end;
comment Not found. (If METAFONT is working, this means the identifier is
extremely long, or it's a parameter name that has been hidden.);
return(s[1 to letsperwd]&"X");
end
else begin comment wxy-identifier;
integer r;
s←cvs(n-namesize) # string representing the index;
idarea←link(p);
loop begin comment search for area;
if idarea=0 then return("wxy??") # unknown indentifier;
if type(idarea)≠areahead then idarea←link(idarea) else done;
end;
if idarea=wvar then return("w"&s);
r←idarea;
while link(r) do
begin integer x;
if(x←name(r)) then s←x&s # put call characters into the name;
r←link(r);
end;
r←field(info,vmemint(idarea));
loop begin comment look thru the x-list;
if r=p then return("x"&s) # x-variable found;
if r=0 then confusion;
if type(r)≠areahead then r←link(r) else done;
end;
r←field(link,vmemint(idarea));
loop begin comment look thru the y-list;
if r=p then return("y"&s) # y-variable found;
if r=0 then confusion;
if type(r)≠areahead then r←link(r) else done;
end;
return("wxy??") # doesn't check out: not w, x, or y;
end;
end;
comment The input stacks: inbuf,curbuf,state,loc,recovery,filename;
comment The state of the scanning routine appears in several stacks.
Global variables inbuf, curbuf, loc, recovery, and filename contain
the current status, while arrays inbufstack, curbfstack, ..., filenmstack contain
the status of activities that have temporarily been suspended. The stack
pointer is called inptr, and it is set so that, for example, inbufstack[0] thru
inbufstack[inptr-1] are the suspended inbufs;
internaldef stacksize=40 # maximum number of simultaneous input sources;
internal saf string array inbufstack[0:stacksize]; internal string inbuf
# current lines being input from a character file;
internal saf string array curbfstack[0:stacksize]; internal string curbuf
# the parts of inbuf that haven't yet been input;
internal saf string array filenmstack[0:stacksize]; internal string filename
# the names of the current character files;
internal saf integer array locstack[0:stacksize]; internal integer loc
# current scanner locations;
internal saf integer array recvrystack[0:stacksize]; internal integer recovery
# information about what to do when done on each level;
comment The upper limit in these declarations is stacksize rather than stacksize-1
so that the dumpcontext routine doesn't cause embarrassing stack overflow;
internal integer inptr # first unused location in input stacks;
comment When the current input is from an external character file (this is indicated
by recovery ≥ 0), inbuf contains the current line, and curbuf contains
the remains of the current line as its characters are being lopped off.
String filename is the name of the file -- this is used only for printing error
messages and returning to the editor (cf. the error procedure in MFSYS).
The loc contains page number and line number of the current line, in its
respective info and link fields. The channel number appears in recovery.
A null filename denotes input from the user terminal. (In this case loc and
recovery are zero.)
When the state specifies reading from an internal linked list of tokens,
inbuf and curbuf and filename are not used. The loc points to the next low-level
token to be scanned, and recovery contains the negative of the address of the
beginning of this token list;
internal string pagewarning # most recent quoted string scanned;
comment When \\{pagewarning} is non-null, the user's source file
probably shouldn't contain any form-feeds (end-of-page marks);
comment The global variable "cond" is true when scanning a condition
(between "if" and the following ":");
boolean cond # "=" signs should be treated as relations like "<";
comment Tokens, token lists, and the diagnostic routines dumplist,dumptokens;
comment A low-level token is either an identifier that isn't a wxy-variable,
or the letter "w", "x", or "y", or a digit, or a punctuation mark.
Subroutines are represented as linked lists of low-level tokens. For example, the
subroutine body (using ":" for semicolons because of SAIL's comment convention)
hpen: lft0 x1 = lft8 xi - 3.05ssd: call`a sb(i): w0 draw 1..i.
consists of the tokens
<hpen>,semi,<lft>,0,x,1,equals,<lft>,8,x,<i>,op-,
3,pnt,0,5,<ssd>,semi,<call>,char a,<sb>,lpren,
<i>,rpren,semi,w,0,<draw>,1,ddot,<i>,fullstop.
Here <...> means an identifier pointer, op- means the operator minus, and so
on. Tokens are represented in mem by type and name fields,
so that, for example, <hpen> has type ident and its name field is a pointer to
the mem entry for that identifier. Note that different uses of certain characters
like "." and "-" are disambiguated in their type fields.
The name field in a token is equal to the
corresponding character whenever possible, so that a token list can be
printed out in a readable form.
A high-level token is like a low-level token except that constants like "3.05"
are combined into one item, and so are wxy-variables. The type of a high-level
token is never "ident", it is the type of the identifier. High-level tokens
that aren't low-level tokens never appear in token lists (since the information
on how to print them is not available).
The token list for a subroutine begins with the identifier representing its name,
followed by tokens indicating parameters (if any), followed by a colon, and it
ends with the "fullstop" token following that subroutine.
The procedure dumplist illustrates the above conventions. It is used
for diagnostic purposes;
internal saf string array tokstring[0:1] # output of dumplist;
internal procedure dumplist(integer p,q) # makes strings out of a token list;
begin comment This procedure is used for diagnostic messages. It creates two
strings from the token list pointed to by p, namely tokstring[0] for all
tokens up to but not including the one pointed to by q, and tokstring[1]
for the remaining tokens if any. For example, if p points to the node <hpen>
in the above example and if q points to the second "0", the result will be
tokstring[0]="hpen: lft0 x1 = lft8 xi - 3."
tokstring[1]="05 ssd: call`a sb(i): w0 draw 1..i."
(But with semicolons instead of colons.)
This routine is intended to be robust in the sense that one can try it while
debugging just to see whether a particular memory location makes sense
if regarded as a token list;
integer j # 0 until q is reached, then 1;
string optspace # " " if next id should be preceded by space, otherwise "";
integer chr,t,n; string s;
if (n←dumplength)≤ 0 then n←1000 # maximum length of strings produced;
tokstring[0]←tokstring[1]←null; j←0; optspace←"";
while p do
begin if p=q then j←1;
if p<0 or p≥memsize then
begin tokstring[j]←tokstring[j]&"CLOBBERED"; done;
end;
t←type(p); chr←name(p);
case t of begin
[ident] if chr<vmemsize then
begin integer typ;
s←optspace&idname(chr); typ←type(chr);
if typ=iff or typ=draw or typ=ddraw or
(typ=unary and vmemint(chr)≠good) then
begin s←s&" "; optspace←"";
end
else optspace←" ";
end
else begin s←optspace&"IMPOSSIBLE"; optspace←" ";
end;
[wxy] begin s←optspace&chr; optspace←"" end;
[lbrace][hashmark][lbrack][pnt][abbs][lpren] begin s←chr; optspace←"" end;
[char] begin s←"`"&chr; optspace←" " end;
[rpren][rbrace][rbrack][digit][apost] begin s←chr; optspace←" " end;
[comma][colon][semi][fullstop] begin s←chr&" "; optspace←"" end;
[ddot] begin s←".."; optspace←"" end;
[varparam] begin s←"(var "&idname(chr)&")"; optspace←"" end;
[indexparam] begin s←"(index "&idname(chr)&")"; optspace←"" end;
[timesordiv] begin s←chr; optspace←"" end;
[rel][equals][plusorminus] begin s←" "&chr&" "; optspace←"" end;
else begin s←optspace&"BAD"; optspace←" " end
end;
tokstring[j]←tokstring[j]&s;
if length(tokstring[j])>n then
begin tokstring[j]←tokstring[j]&optspace&"ETC"; done;
end;
p←link(p);
end;
end;
internal string procedure dumptokens(integer p) # simple special case of dumplist;
begin dumplist(p,0); return(tokstring[0]);
end;